home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 11 / CU Amiga Magazine's Super CD-ROM 11 (1997)(EMAP Images)(GB)(Track 1 of 3)[!][issue 1997-06].iso / cucd / programming / oberonv4 / source / system / input.mod (.txt) < prev    next >
Oberon Text  |  1997-01-28  |  6KB  |  171 lines
  1. Syntax10.Scn.Fnt
  2. Syntax10b.Scn.Fnt
  3. ParcElems
  4. Alloc
  5. MODULE Input;            (* OJ 5-Nov-96, RED parts are still not very nice *)
  6. IMPORT SYSTEM, E := AmigaExec, IE := AmigaInputEvent, I := AmigaIntuition, T := AmigaTimer, Amiga, HostSys;
  7. CONST
  8.     N = 32;    (* buffersize for keystrokes *)
  9.     TimeUnit*= 1000;    (* resolution of Time() is one millisecond *)
  10.     MR = 0; MM = 1; ML = 2;
  11.     ESC = 1BX;  SETUP = 0A4X;  FF = 0CX; QUIT = 0EFX;
  12.     CUP=0C1X;  CDOWN=0C2X;  CLEFT=0C4X;  CRIGHT=0C3X;
  13.     BREAK1=0ACX;  BREAK2=0ADX;
  14.     DEL = 07FX;  BS=08X;
  15.     WindowPtr = POINTER TO I.Window;
  16.     TaskPointer = POINTER TO E.Task;
  17.     n, in, out :INTEGER;    buf : ARRAY N OF CHAR;
  18.     mkeys : SET;
  19.     time, ticksPerUnit, clklo0 : LONGINT;  clk : T.EClockVal;
  20.     R2O : ARRAY 256 OF CHAR;
  21.     mainTask, inputTask : E.TaskPtr;
  22.     exceptSig : SET;
  23. PROCEDURE Exception();
  24. (* exception handler for CTRL-SHIFT-Del *)
  25.     VAR d0 : SET;
  26. BEGIN
  27.     SYSTEM.GETREG( 0, d0 );
  28.     d0 := E.SetExcept( exceptSig, exceptSig );
  29.     HALT(24);
  30.     SYSTEM.PUTREG( 0, d0 )
  31. END Exception;
  32. PROCEDURE InputTask();
  33. (* handles messages from window port *)
  34.     TYPE IntuiMessagePtr=POINTER TO I.IntuiMessage;
  35.     CONST deadKeys = { IE.lShift, IE.rShift, IE.capsLock, IE.control, IE.lAlt, IE.rAlt, IE.lCommand, IE.rCommand };
  36.     VAR window : WindowPtr;    msg : IntuiMessagePtr;    class, qual : SET;    code : INTEGER;    ch : CHAR;
  37.     PROCEDURE Put(ch: CHAR);
  38.     BEGIN
  39.         IF n<N THEN  buf[in] := ch;  in := (in + 1) MOD N;  INC(n)  END;
  40.     END Put;
  41. BEGIN
  42.     window := SYSTEM.VAL(WindowPtr, Amiga.window);
  43.     I.ModifyIDCMP( Amiga.window, {I.rawKey,I.vanillaKey,I.mouseButtons,I.closeWindow} );
  44.     LOOP
  45.         E.WaitPort(window.userPort);
  46.         msg := SYSTEM.VAL(IntuiMessagePtr, E.GetMsg(window.userPort));
  47.         WHILE msg # NIL DO
  48.             class := msg.class;  code := msg.code;  qual := SYSTEM.VAL( SET, LONG(msg.qualifier) );
  49.             E.ReplyMsg(SYSTEM.VAL(E.MessagePtr, msg));
  50.             IF I.mouseButtons IN class THEN
  51.                 CASE code OF
  52.                 | I.selectDown:
  53.                     IF (window.mouseY=0) & (window.mouseX=Amiga.Width-1) & (~Amiga.WBWindow) THEN
  54.                         I.ScreenToBack( window.wScreen )
  55.                     ELSE
  56.                         INCL(mkeys, ML)
  57.                     END
  58.                 | I.selectUp: EXCL(mkeys, ML)
  59.                 | I.menuDown: INCL(mkeys, MR)
  60.                 | I.menuUp: EXCL(mkeys, MR)
  61.                 | I.middleDown: INCL(mkeys, MM)
  62.                 | I.middleUp: EXCL(mkeys, MM)
  63.                 END;
  64.             ELSIF I.rawKey IN class THEN
  65.                 ch := R2O[code];
  66.                 IF qual * {IE.lShift, IE.rShift, IE.capsLock} # {} THEN
  67.                     IF ch = BREAK1 THEN  ch := BREAK2  END;
  68.                 END;
  69.                 IF ch # 0X THEN  Put( ch )  END;
  70.             ELSIF I.vanillaKey IN class THEN
  71.                 ch := CHR(code);  qual := qual*deadKeys;
  72.                 IF qual = {IE.rCommand} THEN
  73.                     CASE ch OF
  74.                     |    "x":    Put( CHR(0FCH) )    (* Cut *)
  75.                     |    "c":    Put( CHR(0FDH) )    (* Copy *)
  76.                     |    "v":    Put( CHR(0FEH) )    (* Paste *)
  77.                     ELSE
  78.                         (* do nothing *)
  79.                     END;
  80.                 ELSIF (qual = {IE.control,IE.lShift}) & (ch = DEL) THEN
  81.                     E.Signal( mainTask, exceptSig );
  82.                 ELSE
  83.                     IF ch=BS THEN  ch:=DEL  ELSIF  ch=DEL THEN  ch:=BS  END;
  84.                     Put( HostSys.toOberon( ch ));
  85.                 END;
  86.             ELSIF I.closeWindow IN class THEN  Put( QUIT );
  87.             END;
  88.             msg := SYSTEM.VAL(IntuiMessagePtr, E.GetMsg(window.userPort))
  89.         END;
  90.     END;
  91. END InputTask;  
  92. PROCEDURE Available*(): INTEGER;
  93. BEGIN
  94.     RETURN n
  95. END Available;  
  96. PROCEDURE Read*(VAR ch: CHAR);
  97. BEGIN
  98.     IF n=0 THEN  HALT(99)  END;
  99.     DEC(n);  ch := buf[out];  out := (out + 1) MOD N
  100. END Read;
  101. PROCEDURE Mouse*(VAR keys: SET; VAR x, y: INTEGER);
  102.     VAR window : WindowPtr;    sp : SHORTINT;
  103. BEGIN
  104.     window := SYSTEM.VAL(WindowPtr, Amiga.window);
  105.     IF I.windowActive IN window.flags THEN
  106.         keys := mkeys;
  107.         IF Amiga.useLAltAsMouse THEN
  108.             SYSTEM.GET(0BFEC01H,sp);
  109.             IF sp = 55 THEN  INCL( keys, MM )  (* ELSE  EXCL( keys, MM ) *) END;
  110.         END;
  111.         x := window.mouseX;  y := Amiga.Height-window.mouseY-1;
  112.         IF x<0 THEN x:=0 ELSIF x>=Amiga.Width THEN x:=Amiga.Width-1 END;
  113.         IF y<0 THEN y:=0 ELSIF y>=Amiga.Height THEN y:=Amiga.Height-1 END;
  114.     ELSE
  115.         keys := {};  x := 0;  y := 0;
  116.     END;
  117. END Mouse;
  118. PROCEDURE SetMouseLimits*(w, h: INTEGER);
  119.     (* NOT SUPPORTED *)
  120. END SetMouseLimits;
  121. PROCEDURE Time*(): LONGINT;
  122. (* should be called at least every 40 mins! *)
  123.     VAR d : LONGINT;
  124.  BEGIN
  125.     d := T.ReadEClock( SYSTEM.ADR(clk) );
  126.     d := ABS(clk.lo - clklo0);
  127.     clklo0 := clk.lo - (d MOD ticksPerUnit);
  128.     INC( time, d DIV ticksPerUnit);
  129.     RETURN time
  130. END Time;
  131. PROCEDURE InitRAWtoOberon; (* Map RAW-Key to Oberon Char *)
  132.     VAR i: INTEGER;
  133. BEGIN
  134.     FOR i:=0 TO 255 DO R2O[i]:=CHR(0) END;
  135.     R2O[50H]:=SETUP;    (* F1 *)
  136.     R2O[51H]:=ESC;    (* F2 *)
  137.     R2O[52H]:=BREAK1;    (* F3 *)
  138.     R2O[53H]:=FF;    (* F4 *)
  139.     R2O[54H]:=0F5X;    (* F5 *)
  140.     R2O[55H]:=0F6X;    (* F6 *)
  141.     R2O[56H]:=0F7X;    (* F7 *)
  142.     R2O[57H]:=0F8X;    (* F8 *)
  143.     R2O[58H]:=0F9X;    (* F9 *)
  144.     R2O[59H]:=0FAX;    (* F10 *)
  145.     R2O[5FH]:=0FBX;    (* HELP *)
  146.     R2O[4CH]:=CUP;    (* Cursor UP *)
  147.     R2O[4DH]:=CDOWN;    (* Cursor DOWN *)
  148.     R2O[4EH]:=CRIGHT;    (* Cursor RIGHT *)
  149.     R2O[4FH]:=CLEFT;    (* Cursor LEFT *)
  150. END InitRAWtoOberon;
  151. PROCEDURE Init();
  152.     VAR task : TaskPointer;  proc : PROCEDURE;
  153. BEGIN
  154.     n := 0;  in := 0;  out := 0;
  155.     ticksPerUnit := (T.ReadEClock( SYSTEM.ADR(clk) ) + (TimeUnit DIV 2)) DIV TimeUnit;
  156.     clklo0 := clk.lo;  time := 0;
  157.     InitRAWtoOberon;
  158.     mainTask := E.FindTask( E.null );  exceptSig := E.SetExcept( {}, {} );
  159.     inputTask := E.CreateTask("O4A-InputTask",1,InputTask,4096);
  160.     task := SYSTEM.VAL( TaskPointer, mainTask );  proc := Exception;
  161.     task.exceptCode := SYSTEM.VAL( LONGINT, proc );
  162. END Init;
  163. PROCEDURE Term();
  164. BEGIN
  165.     IF inputTask#E.null THEN  E.RemTask(inputTask)  END;
  166. END Term;
  167. BEGIN
  168.     inputTask:=E.null;  Amiga.TermProcedure(Term);
  169.     Init();
  170. END Input.
  171.